COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fasload meter)
C00007 ENDMK
C⊗;
(declare (fasload meter)
	 (load "metint.lsp")
	 (setq meter:count-only t))

;;; Don't try to runtime this one.
(declare 
 (setq local-objects-of-interest 
       '(
	 ((store (board (a ?x)) *) "Stores of (board (a x))")
	 ((store (board (b ?x)) *) "Stores of (board (b x))")
	 ((store (board (c ?x)) *) "Stores of (board (c x))")
	 ((store (board ?x) *) "Stores of (board x)")
	 ((store (sequence ?x) *) "Stores of (sequence x)")
	 ((board ?x) "References of (board x)")
	 ((sequence ?x) "References of (board x)"))))

(declare
 (defun (board meter:expand-code) (form l avoid)
	(reference-code form l avoid))
 (defun (sequence meter:expand-code) (form l avoid)
	(reference-code form l avoid))
 (defun (store meter:expand-code) (form l avoid)
	(let ((q (reference-code (cadr form) l avoid)))
	     (cond ((or (atom (caddr form))
			(numberp (caddr form)))
		    `(,(car q) (store ,(cadr q) ,(caddr form))
			       ,(caddr q)))
		   (t (let ((r (gensym)))
			   `(,(append (car q) (ncons r))
			     (store ,(cadr q) ,r)
			     ,(append (caddr q) 
				      (nconp
				       (meter:meter-funs l avoid (caddr form))))))))))
 (defun reference-code (form l avoid)
	(cond ((atom ?x) 
	       `(() ,form ()))
	      (t (let ((r (gensym)))
			    `((,r)
			      ,(subst r ?x form)
			      (,(meter:meter-funs l avoid ?x)))))))
)

(declare (array* (fixnum board 1 a 1 b 1 c 1 sequence 1)) 
	 (fixsw t)
	 (special answer final))

(eval-when (compile load eval)
	   (setq base 10. ibase 10.))

(array board fixnum 16.)
(array sequence fixnum 14.)
(array a fixnum 37.)
(array b fixnum 37.)
(array c fixnum 37.)

(fillarray 'board '(1))
(store (board 5) 0)

(fillarray 'a '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4
		  4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6))

(fillarray 'b '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
		  2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5))

(fillarray 'c '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
		  1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4))

(meter:meter triang
 (meter-funs #.(all-objs)
(defun last-position ()
       (mn "LAST-POSITION" lp)
       (do ((i 1 (1+ i)))
	   ((= i 16.) 0)
	   (cond ((= 1 (board i)) (return i)))))) 

 (meter-funs #.(all-objs)
(defun try (i depth)
       (mn "TRY" try)
       (cond ((= depth 14) 
	      (let ((lp (last-position)))
		   (cond ((member lp final))
			 (t (push lp final))))
	      (push (cdr (listarray 'sequence)) answer) t)
	     ((and (= 1 (board (a i)))
		   (= 1 (board (b i)))
		   (= 0 (board (c i))))
	      (store (board (a i)) 0)
	      (store (board (b i)) 0)
	      (store (board (c i)) 1)
	      (store (sequence depth) i)
	      (do ((j 0 (1+ j))
		   (depth (1+ depth)))
		  ((or (= j 36.)
		       (try j depth)) ()))
	      (store (board (a i)) 1)
	      (store (board (b i)) 1)
	      (store (board (c i)) 0)())))))

(defun gogogo (i)
       (let ((answer ())
	     (final ()))
	    (try i 1)))